home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / ncurses2-color_edit.adb < prev    next >
Text File  |  2002-10-24  |  10KB  |  265 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                                 ncurses                                  --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 2000 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  37. --  Version Control
  38. --  $Revision: 1.1 $
  39. --  Binding Version 01.00
  40. ------------------------------------------------------------------------------
  41. with ncurses2.util; use ncurses2.util;
  42. with ncurses2.genericPuts;
  43. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  44.  
  45.  
  46. procedure ncurses2.color_edit is
  47.    use Int_IO;
  48.  
  49.    type RGB_Enum is (Redx, Greenx, Bluex);
  50.  
  51.    procedure change_color (current : Color_Number;
  52.                            field   : RGB_Enum;
  53.                            value   : RGB_Value;
  54.                            usebase : Boolean);
  55.  
  56.  
  57.  
  58.    procedure change_color (current : Color_Number;
  59.                            field   : RGB_Enum;
  60.                            value   : RGB_Value;
  61.                            usebase : Boolean)  is
  62.       red, green, blue : RGB_Value;
  63.    begin
  64.       if usebase then
  65.          Color_Content (current, red, green, blue);
  66.       else
  67.          red := 0;
  68.          green := 0;
  69.          blue := 0;
  70.       end if;
  71.  
  72.       case field is
  73.          when Redx => red :=  red + value;
  74.          when Greenx => green := green + value;
  75.          when Bluex => blue := blue + value;
  76.       end case;
  77.  
  78.       declare
  79.       begin
  80.          Init_Color (current, red, green, blue);
  81.       exception
  82.          when Curses_Exception => Beep;
  83.       end;
  84.  
  85.    end change_color;
  86.  
  87.  
  88.    package x is new ncurses2.genericPuts (100); use x;
  89.  
  90.    tmpb : x.BS.Bounded_String;
  91.  
  92.    tmp4 : String (1 .. 4);
  93.    tmp6 : String (1 .. 6);
  94.    tmp8 : String (1 .. 8);
  95.    --  This would be easier if Ada had a Bounded_String
  96.    --  defined as a class instead of the inferior generic package,
  97.    --  then I could define Put, Add, and Get for them. Blech.
  98.    value : RGB_Value := 0;
  99.    red, green, blue : RGB_Value;
  100.    max_colors : constant Natural := Number_Of_Colors;
  101.    current : Color_Number := 0;
  102.    field : RGB_Enum := Redx;
  103.    this_c : Key_Code := 0;
  104.    last_c : Key_Code;
  105. begin
  106.    Refresh;
  107.  
  108.    for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
  109.       Init_Pair (Color_Pair (i), White, i);
  110.    end loop;
  111.  
  112.    Move_Cursor (Line => Lines - 2, Column => 0);
  113.    Add (Str => "Number: ");
  114.    myPut (tmpb, Integer (value));
  115.    myAdd (Str => tmpb);
  116.  
  117.    loop
  118.  
  119.       Switch_Character_Attribute (On => False,
  120.                                   Attr => (Bold_Character => True,
  121.                                            others => False));
  122.       Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
  123.  
  124.       Switch_Character_Attribute (On => False,
  125.                                   Attr => (Bold_Character => True,
  126.                                            others => False));
  127.  
  128.       for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
  129.          Move_Cursor (Line => 2 + Line_Position (i), Column => 0);
  130.          if current = i then
  131.             Add (Ch => '>');
  132.          else
  133.             Add (Ch => ' ');
  134.          end if;
  135.          --  TODO if i <= color_names'Max  then
  136.          Put (tmp8, Integer (i));
  137.          Set_Character_Attributes (Color => Color_Pair (i));
  138.          Add (Str => "        ");
  139.          Set_Character_Attributes;
  140.  
  141.          Refresh;
  142.  
  143.          Color_Content (i, red, green, blue);
  144.          Add (Str => "   R = ");
  145.          if current = i and field = Redx then
  146.             Switch_Character_Attribute (On => True,
  147.                                         Attr => (Stand_Out => True,
  148.                                                  others => False));
  149.          end if;
  150.          Put (tmp4, Integer (red));
  151.          Add (Str => tmp4);
  152.          if current = i and field = Redx then
  153.             Set_Character_Attributes;
  154.          end if;
  155.          Add (Str => "   G = ");
  156.          if current = i and field =  Greenx then
  157.             Switch_Character_Attribute (On => True,
  158.                                         Attr => (Stand_Out => True,
  159.                                                  others => False));
  160.          end if;
  161.          Put (tmp4, Integer (green));
  162.          Add (Str => tmp4);
  163.          if current = i and field = Greenx then
  164.             Set_Character_Attributes;
  165.          end if;
  166.          Add (Str => "   B = ");
  167.          if current = i and field = Bluex then
  168.             Switch_Character_Attribute (On => True,
  169.                                         Attr => (Stand_Out => True,
  170.                                                  others => False));
  171.          end if;
  172.          Put (tmp4, Integer (blue));
  173.          Add (Str => tmp4);
  174.          if current = i and field = Bluex then
  175.             Set_Character_Attributes;
  176.          end if;
  177.          Set_Character_Attributes;
  178.          Add (ch => ')');
  179.       end loop;
  180.       Add (Line => Line_Position (Number_Of_Colors + 3), Column => 0,
  181.            Str => "Use up/down to select a color, left/right to change " &
  182.            "fields.");
  183.       Add (Line => Line_Position (Number_Of_Colors + 4), Column => 0,
  184.            Str => "Modify field by typing nnn=, nnn-, or nnn+.  ? for help.");
  185.  
  186.       Move_Cursor (Line => 2 + Line_Position (current), Column => 0);
  187.  
  188.       last_c := this_c;
  189.       this_c := Getchar;
  190.       if Is_Digit (this_c) then
  191.          value := 0;
  192.       end if;
  193.  
  194.       case this_c is
  195.          when KEY_UP =>
  196.             current := (current - 1) mod Color_Number (max_colors);
  197.          when KEY_DOWN =>
  198.             current := (current + 1) mod Color_Number (max_colors);
  199.          when KEY_RIGHT =>
  200.             field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3);
  201.          when KEY_LEFT =>
  202.             field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3);
  203.          when
  204.            Character'Pos ('0') |
  205.            Character'Pos ('1') |
  206.            Character'Pos ('2') |
  207.            Character'Pos ('3') |
  208.            Character'Pos ('4') |
  209.            Character'Pos ('5') |
  210.            Character'Pos ('6') |
  211.            Character'Pos ('7') |
  212.            Character'Pos ('8') |
  213.            Character'Pos ('9')  =>
  214.             value := value * 10 + RGB_Value (ctoi (Code_To_Char (this_c)));
  215.  
  216.          when Character'Pos ('+') =>
  217.             change_color (current, field,  value, True);
  218.  
  219.          when Character'Pos ('-') =>
  220.             change_color (current, field, -value, True);
  221.  
  222.          when Character'Pos ('=') =>
  223.             change_color (current, field,  value, False);
  224.  
  225.          when Character'Pos ('?') =>
  226.             Erase;
  227.             P ("                      RGB Value Editing Help");
  228.             P ("");
  229.             P ("You are in the RGB value editor.  Use the arrow keys to " &
  230.                "select one of");
  231.             P ("the fields in one of the RGB triples of the current colors;" &
  232.                " the one");
  233.             P ("currently selected will be reverse-video highlighted.");
  234.             P ("");
  235.             P ("To change a field, enter the digits of the new value; they" &
  236.                " are echoed");
  237.             P ("as entered.  Finish by typing `='.  The change will take" &
  238.                " effect instantly.");
  239.             P ("To increment or decrement a value, use the same procedure," &
  240.                " but finish");
  241.             P ("with a `+' or `-'.");
  242.             P ("");
  243.             P ("To quit, do `x' or 'q'");
  244.  
  245.             Pause;
  246.             Erase;
  247.          when Character'Pos ('q') |
  248.            Character'Pos ('x') =>
  249.             null;
  250.          when others =>
  251.             Beep;
  252.       end case;
  253.       Move_Cursor (Line => Lines - 2, Column => 0);
  254.       Put (tmp6, Integer (value));
  255.       Add (Str => "Number: " & tmp6);
  256.  
  257.       Clear_To_End_Of_Line;
  258.       exit when this_c = Character'Pos ('x') or
  259.         this_c = Character'Pos ('q');
  260.    end loop;
  261.  
  262.    Erase;
  263.    End_Windows;
  264. end ncurses2.color_edit;
  265.